SuperHack/SuperHack CD.bin/CODING/MISC/MAG10.ZIP/FANGLORE.PAS

Pascal/Delphi Source File | 1996-08-19 | 21.4 KB | 671 lines

{ ************************************************************************** }
{ *                                                                        * }
{ *                                FANGLORE                                * }
{ *                                                                        * }
{ *                             BY SPELLCASTER                             * }
{ *                                                                        * }
{ *                              VERSION 0.30                              * }
{ *                                                                        * }
{ *                            DATE : 6-8-1996                             * }
{ *                                                                        * }
{ *                                                                        * }
{ *  Developed of 'The Mag', for the 'Designing a Text Adventure'          * }
{ *  series of articles...                                                 * }
{ *                                                                        * }
{ ************************************************************************** }

Program FangLore;

{ ************************************************************************** }
{ ************************** Unit definition ******************************* }
{ ************************************************************************** }

Uses Crt;    { Use CRT for cute text procedures :) }

{ ************************************************************************** }
{ ************************* Constant definition **************************** }
{ ************************************************************************** }

Const NumberRooms=22;   { Number of rooms in the game }
      NumberObjs=6;     { Number of objects in the game }

{ ************************************************************************** }
{ *************************** Type definition ****************************** }
{ ************************************************************************** }

Type RoomType=Record
                    Desc:Array[1..10] of String[79];  { Description }
                    North,South,East,West:Byte;       { Exits }
              End;

     ParsedType=Array[1..10] Of String;

     ObjType=Record
                   Name:String[80];
                   Pos:Byte;
                   Desc:Array[1..5] Of String[80];
             End;

{ ************************************************************************** }
{ ************************* Variable definition **************************** }
{ ************************************************************************** }

Var Rooms:Array[1..NumberRooms] of RoomType;   { Room data }
    CurrentRoom:Word;                          { Speaks for itself... :) }
    Objects:Array[1..NumberObjs] of ObjType;   { Object data }
    Mask:Boolean;                              { See text for explanation }

{ ************************************************************************** }
{ ************************ Procedure definition **************************** }
{ ************************************************************************** }

Function FindSpace(S:String;Start:Byte):Byte;     { Finds the first space    }
                                                  { after the indicated char }
Begin
     While (S[Start+1]<>' ') And (Start<Length(S)) Do Inc(Start);
     FindSpace:=Start;
End;

Function GetString(S:String;Start,Finish:Byte):String;    { Gets a piece of }
                                                          { a string        }
Var A:Byte;
    Tmp:String;
Begin
     Tmp:='';
     For A:=Start+1 To Finish Do Tmp:=Tmp+S[A];
     GetString:=Tmp;
End;

Function Upper(S:String):String;
Var Tmp:String;
    A:Byte;
Begin
     Tmp:='';
     For A:=1 To Length(S) Do Tmp:=Tmp+UpCase(S[A]);
     Upper:=Tmp;
End;

Procedure Parse(S:String;Var Parsed:ParsedType);   { Parses a string }
Var ArrayIndex:Byte;
    StringIndex:Byte;
    NextSpace:Byte;
Begin
     ArrayIndex:=1;
     StringIndex:=0;
     NextSpace:=FindSpace(S,StringIndex);
     While (StringIndex<=Length(S)) And (ArrayIndex<11) Do
     Begin
          NextSpace:=FindSpace(S,StringIndex);
          Parsed[ArrayIndex]:=GetString(S,StringIndex,NextSpace);
          StringIndex:=NextSpace+1;
          Inc(ArrayIndex);
     End;
End;

Procedure Elimin(Var Parsed:ParsedType;Var Index:Byte);
Var A:Byte;
Begin
     For A:=Index To 9 Do Parsed[A]:=Parsed[A+1];
     Parsed[10]:='';
     Dec(Index);
End;

Procedure EliminPrenoms(Var Parsed:ParsedType);
Var A:Byte;
Begin
     For A:=1 To 10 Do
     Begin
          If Parsed[A]='THE' Then Elimin(Parsed,A);
          If Parsed[A]='A' Then Elimin(Parsed,A);
          If Parsed[A]='ON' Then Elimin(Parsed,A);
     End;
End;

Procedure ReadRoomData;     { Read from the disk the room data }
Var F:Text;
    A,B:Byte;
    Flag:Boolean;
Begin
     { Prepares the text file for accessing }
     Assign(F,'Room.Dat');
     Reset(F);
     { For every room in the game }
     For A:=1 To NumberRooms Do
     Begin
          { Clear the room's description }
          For B:=1 To 10 Do Rooms[A].Desc[B]:='';
          { Read the description of the room }
          Flag:=True;
          B:=1;
          While Flag Do
          Begin
               Readln(F,Rooms[A].Desc[B]);
               If (B=10) Or (Rooms[A].Desc[B]='*') Then Flag:=False;
               Inc(B);
          End;
          { Read exit data }
          Readln(F,Rooms[A].North);
          Readln(F,Rooms[A].South);
          Readln(F,Rooms[A].East);
          Readln(F,Rooms[A].West);
     End;
     Close(F);
End;

Procedure ReadObjData;     { Read from the disk the object data }
Var F:Text;
    A,B:Byte;
    Flag:Boolean;
Begin
     { Prepares the text file for accessing }
     Assign(F,'Obj.Dat');
     Reset(F);
     { For every object in the game }
     For A:=1 To NumberObjs Do
     Begin
          { Read the name of the objects }
          ReadLn(F,Objects[A].Name);
          { Read the initial position of the objects }
          ReadLn(F,Objects[A].Pos);
          { Clear the object's description }
          For B:=1 To 5 Do Objects[A].Desc[B]:='';
          { Read the description of the room }
          Flag:=True;
          B:=1;
          While Flag Do
          Begin
               ReadLn(F,Objects[A].Desc[B]);
               If (B=5) Or (Objects[A].Desc[B]='*') Then Flag:=False;
               Inc(B);
          End;
     End;
     Close(F);
End;

Procedure Look(RoomNumber:Word);        { Looks at the room }
Var A:Byte;
    Flag:Boolean;
Begin
     Writeln;
     A:=1;
     TextColor(White);
     While (A<11) And (Rooms[RoomNumber].Desc[A]<>'*') Do
     Begin
          Writeln(Rooms[RoomNumber].Desc[A]);
          Inc(A);
     End;
     Writeln;
     TextColor(Yellow);
     Writeln('Visible exits:');
     If Rooms[RoomNumber].North<>0 Then Write('North      ');
     If Rooms[RoomNumber].South<>0 Then Write('South      ');
     If Rooms[RoomNumber].East<>0 Then Write('East       ');
     If Rooms[RoomNumber].West<>0 Then Write('West       ');
     WriteLn;
     WriteLn;
     TextColor(LightCyan);
     Writeln('Visible objects:');
     Flag:=False;
     For A:=1 To NumberObjs Do If Objects[A].Pos=RoomNumber Then
     Begin
          WriteLn('         ',Objects[A].Name);
          Flag:=True;
     End;
     If Flag=False Then Writeln('          None');
     WriteLn;
End;

Procedure Inventory;
Var A:Byte;
    Flag:Boolean;
Begin
     Flag:=False;
     TextColor(LightBlue);
     WriteLn;
     WriteLn('Objects carried:');
     For A:=1 To NumberObjs Do If Objects[A].Pos=0 Then
     Begin
          WriteLn('                ',Objects[A].Name);
          Flag:=True;
     End;
     If Flag=False Then Writeln('                None');
     WriteLn;
End;

Procedure Examine(Param:String);
Var Flag:Boolean;
    A,B:Byte;
Begin
     { ***************************************************** }
     { Here we'll include code for things like the oven, etc }
     { ***************************************************** }
     { Search the object in the object list }
     A:=0;
     Flag:=False;
     Repeat
           Inc(A);
           If Upper(Objects[A].Name)=Param Then Flag:=True;
     Until Flag Or (A>NumberObjs);
     If Flag Then
     Begin
          { The object exists }
          { Check if it is in the room or in your possession }
          If (Objects[A].Pos=0) Or (Objects[A].Pos=CurrentRoom) Then
          Begin
               { The object is 'visible'... Write description }
               Writeln;
               B:=1;
               TextColor(Yellow);
               While (B<6) And (Objects[A].Desc[B]<>'*') Do
               Begin
                    Writeln(Objects[A].Desc[B]);
                    Inc(B);
               End;
               Writeln;
          End
          Else
          Begin
               { The object exists, but it's not visible }
               Writeln;
               TextColor(Yellow);
               WriteLn('I can''t see the ',Param,' here...');
               WriteLn;
          End;
     End
     Else
     Begin
          { The specified parameter doesn't represent any existing }
          { object...                                              }
          WriteLn;
          TextColor(Yellow);
          WriteLn('Sorry, but I don''t even know what is a ',Param);
          WriteLn;
     End;
End;

Procedure Get(O:String);
Var A:Byte;
    Flag:Boolean;
Begin
     Flag:=False;
     A:=0;
     Repeat
           Inc(A);
           If O=Upper(Objects[A].Name) Then Flag:=True;
     Until (A>NumberObjs) Or (Flag=True);
     If Flag=True Then
     Begin
          { The object exists }
          If Objects[A].Pos=CurrentRoom Then
          Begin
               { The object is in the current room }
               { Get the object }
               Objects[A].Pos:=0;
               TextColor(LightCyan);
               WriteLn;
               WriteLn('You get the ',O);
               WriteLn;
          End
          Else
          Begin
               If Objects[A].Pos=0 Then
               Begin
                    { The object is already in the possession }
                    { of the player...                        }
                    TextColor(LightCyan);
                    WriteLn;
                    WriteLn('You already have the ',O);
                    WriteLn;
               End
               Else
               Begin
                    WriteLn('You don''t see the ',O);
                    WriteLn;
               End;
          End;
     End
     Else
     Begin
          { The object doesn't exist }
          WriteLn;
          TextColor(LightRed);
          Writeln('What are you talking about ?');
          Writeln;
     End;
End;

Procedure Drop(O:String);
Var A:Byte;
    Flag:Boolean;
Begin
     Flag:=False;
     A:=0;
     Repeat
           Inc(A);
           If (O=Upper(Objects[A].Name)) And (Objects[A].Pos=0) Then
             Flag:=True;
     Until (A>NumberObjs) Or (Flag=True);
     If Flag=True Then
     Begin
          { The object is in the player's possession }
          Objects[A].Pos:=CurrentRoom;
          TextColor(LightCyan);
          WriteLn;
          WriteLn('You drop the ',O);
          WriteLn;
     End
     Else
     Begin
          { The object doesn't exist or it isn't in the }
          { player's possession... }
          TextColor(LightRed);
          WriteLn;
          WriteLn('You don''t have the ',O);
          WriteLn;
     End;
End;

Procedure Use(Arg:ParsedType);
Var A:Byte;
    Flag:Boolean;
Begin
     Flag:=False;
     A:=0;
     Repeat
           Inc(A);
           If (Arg[2]=Upper(Objects[A].Name)) And (Objects[A].Pos=0) Then Flag:=True;
     Until (A>NumberObjs) Or (Flag=True);
     If Flag=True Then
     Begin
          { The object is "usable" }
          Flag:=False;
          { Check if player want to use the shovel }
          If Arg[2]='SHOVEL' Then
          Begin
               Flag:=True;
               { Check if it is used with the door }
               If Arg[3]='DOOR' Then
               Begin
                    { Check if the player is in the proper }
                    { location...                          }
                    If CurrentRoom=20 Then
                    Begin
                         { The player is in the right place }
                         { Open passage between the garden  }
                         { and the mansion...               }
                         Rooms[20].North:=15;
                         TextColor(LightCyan);
                         WriteLn;
                         WriteLn('You knock the door down...');
                         WriteLn;
                    End
                    Else
                    Begin
                         { The player is someplace else }
                         TextColor(LightRed);
                         WriteLn;
                         WriteLn('I don''t see a door...');
                         WriteLn;
                    End;
               End
               Else
               Begin
                    { The player didn't used the shovel with }
                    { the door...                            }
                    TextColor(LightRed);
                    WriteLn;
                    WriteLn('Use it with what ?!');
                    WriteLn;
               End;
          End;
          If Arg[2]='SWORD' Then
          Begin
               Flag:=True;
               { I'll include the code here in a future  }
               { issue, when I'll talk about monsters... }
          End;
     End;
     If Flag=False Then
     Begin
          { No "legal" objects were used }
          TextColor(LightRed);
          WriteLn;
          WriteLn('Can''t use that...');
          WriteLn;
     End;
End;

Procedure Init;      { Initializes game data }
Begin
     ReadRoomData;
     ReadObjData;
     CurrentRoom:=22;
     Mask:=False;
     TextColor(LightGray);
     TextBackground(Black);
     Clrscr;
End;

Procedure Play;      { Playing the game }
Var ExitFlag:Boolean;
    Valid:Boolean;
    Command:String;
    Parsed:ParsedType;
    A,D:Byte;
    C:Char;
    E:String;
Begin
     ExitFlag:=False;
     Look(CurrentRoom);
     Repeat
           Valid:=False;
           TextColor(White);
           Writeln('What is thy bidding, master ?');
           TextColor(LightGreen);
           Readln(Command);
           { Clear the array }
           For A:=1 To 10 Do Parsed[A]:='';
           Parse(Command,Parsed);
           { Convert to uppercase }
           For A:=1 To 10 Do Parsed[A]:=Upper(Parsed[A]);
           { Eliminate prenoms }
           EliminPrenoms(Parsed);
           { Execute comands }
           If Parsed[1]='LOOK' Then
           Begin
                Valid:=True;
                Look(CurrentRoom);
           End;
           If Parsed[1]='INVENTORY' Then
           Begin
                Valid:=True;
                Inventory;
           End;
           If Parsed[1]='EXAMINE' Then
           Begin
                Valid:=True;
                { Join the words again }
                D:=3;
                E:=Parsed[2];
                While Parsed[D]<>'' Do
                Begin
                     E:=E+' '+Parsed[D];
                     Inc(D);
                End;
                Examine(E);
           End;
           If Parsed[1]='GET' Then
           Begin
                Valid:=True;
                { Join the words again }
                D:=3;
                E:=Parsed[2];
                While Parsed[D]<>'' Do
                Begin
                     E:=E+' '+Parsed[D];
                     Inc(D);
                End;
                Get(E);
           End;
           If Parsed[1]='DROP' Then
           Begin
                Valid:=True;
                { Join the words again }
                D:=3;
                E:=Parsed[2];
                While Parsed[D]<>'' Do
                Begin
                     E:=E+' '+Parsed[D];
                     Inc(D);
                End;
                Drop(E);
           End;
           If Parsed[1]='WEAR' Then
           Begin
                { Join the words again }
                D:=3;
                E:=Parsed[2];
                While Parsed[D]<>'' Do
                Begin
                     E:=E+' '+Parsed[D];
                     Inc(D);
                End;
                If E='GAS MASK' Then
                Begin
                     { Check if the player has the gas mask     }
                     { We know that the mask is object number 2 }
                     Valid:=True;
                     If Objects[2].Pos=0 Then
                     Begin
                          Mask:=True;
                          TextColor(LightCyan);
                          WriteLn;
                          WriteLn('You wear the gas mask...');
                          WriteLn;
                     End
                     Else
                     Begin
                          TextColor(LightRed);
                          WriteLn;
                          WriteLn('You don''t have the gas mask.');
                          WriteLn;
                     End;
                End;
           End;
           If Parsed[1]='USE' Then
           Begin
                Valid:=True;
                Use(Parsed);
           End;
           If (Parsed[1]='N') Or (Parsed[1]='NORTH') Then
           Begin
                If Rooms[CurrentRoom].North=0 Then
                Begin
                     TextColor(LightRed);
                     Writeln;
                     Writeln('Sorry, oh Great Lord, but I can''t go that way !');
                     Writeln;
                End
                Else
                Begin
                     TextColor(LightRed);
                     Writeln;
                     Writeln('You go north...');
                     CurrentRoom:=Rooms[CurrentRoom].North;
                     Writeln;
                     Look(CurrentRoom);
                End;
                Valid:=True;
           End;
           If (Parsed[1]='S') Or (Parsed[1]='SOUTH') Then
           Begin
                If Rooms[CurrentRoom].South=0 Then
                Begin
                     TextColor(LightRed);
                     Writeln;
                     Writeln('Sorry, oh Great Lord, but I can''t go that way !');
                     Writeln;
                End
                Else
                Begin
                     TextColor(LightRed);
                     Writeln;
                     Writeln('You go south...');
                     CurrentRoom:=Rooms[CurrentRoom].South;
                     Writeln;
                     Look(CurrentRoom);
                End;
                Valid:=True;
           End;
           If (Parsed[1]='E') Or (Parsed[1]='EAST') Then
           Begin
                If Rooms[CurrentRoom].East=0 Then
                Begin
                     TextColor(LightRed);
                     Writeln;
                     Writeln('Sorry, oh Great Lord, but I can''t go that way !');
                     Writeln;
                End
                Else
                Begin
                     TextColor(LightRed);
                     Writeln;
                     Writeln('You go east...');
                     CurrentRoom:=Rooms[CurrentRoom].East;
                     Writeln;
                     Look(CurrentRoom);
                End;
                Valid:=True;
           End;
           If (Parsed[1]='W') Or (Parsed[1]='WEST') Then
           Begin
                If Rooms[CurrentRoom].West=0 Then
                Begin
                     TextColor(LightRed);
                     Writeln;
                     Writeln('Sorry, oh Great Lord, but I can''t go that way !');
                     Writeln;
                End
                Else
                Begin
                     TextColor(LightRed);
                     Writeln;
                     Writeln('You go west...');
                     CurrentRoom:=Rooms[CurrentRoom].West;
                     Writeln;
                     Look(CurrentRoom);
                End;
                Valid:=True;
           End;
           If Parsed[1]='QUIT' Then
           Begin
                Valid:=True;
                TextColor(LightMagenta);
                Writeln;
                Writeln('Are you sure you want to quit FangLore (Y/N) ?');
                C:=ReadKey;
                If UpCase(C)='Y' Then ExitFlag:=True;
                Writeln;
           End;
           If Not Valid Then
           Begin
                Writeln;
                TextColor(LightRed);
                If Random(100)>50 Then
                   Writeln('Sorry mylord, by thy bidding can''t be obbeyed...')
                Else
                   Writeln('What ?! How the hell am I supposed to do that ??');
                Writeln;
           End;
     Until ExitFlag;
End;

{ ************************************************************************** }
{ **************************** Main  Program ******************************* }
{ ************************************************************************** }

Begin
     Init;
     Play;
End.